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-- DUserProc.Mesa 
-- Edited by: 

Sandman, April 15, 1978 3:35 PM 
Jerry Morrison, March 29, 1978 2:57 PM 
Barbara, May 12, 1978 4:21 PM 
Johnsson, August 30, 1978 10:51 AM 
Checks on ControlDELtyped before calling a userproc 
Allows the user to type any unique partial userproc name 

DIRECTORY 

DebugUsefulDefs: FROM "debugusefuldef s" , 

DebugUtilityDefs: FROM "debugutil i tydef s'\ 

IODefs: FROM "iodefs" USING [CR, ReadEditedString , Rubout, WriteChar, WriteLine, WriteStr ing] , 

StreamDefs: FROM "streamdefs" USING [ControlDELtyped], 

StringDefs: FROM "stringdefs" USING [AppendString, EquivalentString, EquivalentSubStrings , Substring, 
** SubStr ingDescriptor] , 

SystemDefs: FROM "systemdef s" USING [Al locateHeapNode, AllocateHeapString] ; 

DUserProc: PROGRAM 

IMPORTS IODefs, StreamDefs, StringDefs, SystemDefs 
EXPORTS DebugUsefulDefs, DebugUtilityDefs » 

BEGIN 

AmbiguousTag: PUBLIC SIGNAL [oldTag: STRING] - CODE; 

ProcHandle: TYPE - POINTER TO Procltem; 
Procltem: TYPE « RECORD [ 

link: ProcHandle, 

item: STRING, 

proc: PROCEDURE]; 

head: ProcHandle «- NIL; 

AddCommand: PUBLIC PROCEDURE [tag: STRING, proc: PROCEDURE] - 
BEGIN 

p, new: ProcHandle; 
IF (new <- Unique[tag]) » NIL THEN 

BEGIN 

SIGNAL AmbiguousTag[tag]; 

new. proc «- proc; 

RETURN 

END; 
new <- SystemDefs .AllocateHeapNode[SIZE[ProcItem]] ; 
new. item <- SystemDefs . AllocateHeapString[tag . length]; 
new. item, length <- 0; 

StringDefs. AppendString[to: new. item, from: tag]; 
new. proc <- proc; 
new. link «- NIL; 
IF head - NIL THEN head 4- new 
ELSE 

FOR p «- head, p. link jDO 

IF p. link « NIL THEN BEGIN p. link 4- new; EXIT END; 
ENDLOOP; 
RETURN 
END; -- Of AddCommand 

NoUserProcsLoaded: PUBLIC SIGNAL ■ CODE; 

UserProc: PUBLIC PROCEDURE ■ 
BEGIN OPEN IODefs; 
i: ProcHandle; 
s: STRING «- [40]; 
prompt: STRING ■ "Proc: "L; 

eol: PROCEDURE [c: CHARACTER] RETURNS [BOOLEAN] ■ 
BEGIN 

IF s. length > THEN RETURN[c * CR]; 
IF c ■ '? THEN BEGIN Wr i teChar[c] ; RETURN[TRUE] END; 
RETURN [c - CR] 
END; 

IF head - NIL THEN BEGIN SIGNAL NoUserProcsLoaded; RETURN END; 
IF head. link - NIL THEN 

BEGIN 

WriteStr ing [prompt] ; 
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IF StreamDefs.ControlDELtyped[] THEN 

BEGIN WriteLine[" ... aborted"!.]; RETURN END; 
WriteLine[head. item]; 
head.proc[]; 
RETURN; 
END; 
DO 

WriteString[ prompt]; 

[] «- ReadEditedString[s, eol , TRUE ! Rubout »> GOTO del]; 

IF StreamDefs.ControlDELtyped[] THEN GOTO aborted; 

WriteChar[CR]; 

IF (i «- Match[s]) # NIL THEN BEGIN i.proc[]; RETURN; END; 

FOR i <- head, i.link UNTIL i ■ NIL DO 

IF StreamDefs.ControlDELtyped[] THEN GOTO aborted; 

WriteLine[i . item]; 

ENDLOOP; 
REPEAT 

del -> WriteLine[" XXX"L]; 

aborted ■> WriteLine[" ... aborted"L]; 
ENDLOOP; 
END; -- Of CallUserProc 

--Unique scans the list of installed userprocs for an exact match with s 
Unique: PROCEDURE [s: STRING] RETURNS [pr: ProcHandle] ■ 
BEGIN 
FOR pr 4- head, pr.link UNTIL pr ■ NIL DO 

IF StringDefs.EquivalentString[pr .item.s] THEN RETURN 
ENDLOOP; 
RETURN[NIL] 
END; -- Of Unique 

-- Match scans the list of userprocs for any unique name specification 
Match: PROCEDURE [name: STRING] RETURNS [prO: ProcHandle] - 
BEGIN 

prl: ProcHandle; 

IF (prO <- Unique[name]) # NIL THEN RETURN; -- first check for exact match 
-- that failed; so scan for a unique partial specification 
FOR prO «- head, prO.link UNTIL prO = NIL DO 
IF MatchFirstPart[name , prO.item] THEN 

-- the specified name matches a Userproc name; make sure it's unique 
FOR prl «- prO, link, prl. link UNTIL prl = NIL DO 

IF MatchFirstPart[name, prl. item] THEN RETURN [NIL] -- not unique 
REPEAT 

FINISHED = > RETURN; -- name is a unique partial spec 
ENDLOOP; 
ENDLOOP; 
RETURN [NIL] -- didn't find name on either scan 
END; -- of Match 

-- MatchFirstPart returns TRUE iff short matches the first part of long 
MatchFirstPart: PROCEDURE [short, long: STRING] RETURNS [BOOLEAN] ■ 

BEGIN OPEN StringDefs; 

shortSSD: SubStringDescriptor «- [short, 0, short. length] ; 

longSSD: SubStringDescriptor «- [long, 0, short . length] ; 

shortSS: Substring <- @shortSSD; 

longSS: Substring <- QlongSSD; 

RETURN[ 

long. length > short. length AND EquivalentSubStrings[shortSS, longSS]]; 

END; -- of MatchFirstPart 



END. , 



